home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / MCQUAY1 / MENUDEMO.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-31  |  3KB  |  105 lines
  1. program ShadMenuDemo;
  2. {---------------------------------------------
  3.  A Very Simple Demo of Shadow Menu which  uses
  4.  Shadow Class concepts to fix an undesirable
  5.  feature of the TMenuBox Class in Turbo Vision
  6.  This Version REQUIRES a mouse!
  7.  ---------------------------------------------}
  8. uses Objects, App, Drivers, Views, Menus
  9.         , ShadMenu  {Comment Out This Line to See Undesirable Feature }
  10.         ;{Uses}
  11.  
  12. const
  13.     cmNewWin = 2000;       { Command to insert a New Window }
  14.     cmDoNothing = 2001;    { Just That! }
  15.     cmShowDisabled = 100;  { Used for Disabled Menu Item}
  16.     cmToggleColor = 2002;  { Command to change New Window Palette }
  17.     WinColor:byte = 0;     { Used to Set New Window Palette}
  18. type
  19.     TInsApp = object(TApplication)
  20.         WinCount: Integer;
  21.         procedure HandleEvent(var Event: TEvent); virtual;
  22.         procedure InitMenuBar; virtual;
  23.         end;
  24.  
  25.     PWindowMenuBar = ^TWindowMenuBar;
  26.     TWindowMenuBar = object(TMenuBar)
  27.         function GetPalette:PPalette; virtual;
  28.         end;
  29. {-----------------------------------------}
  30. { Creates a test menu to insert in a Window }
  31.     function TestMenu(R:Trect):PmenuBar;
  32.         var
  33.             P:PMenuBar;
  34.         begin
  35.             P := New(PWindowMenuBar, Init(R,
  36.              NewMenu(
  37.                  NewSubMenu('Sub Menu ~O~ne',hcNoContext,
  38.                      NewMenu(
  39.                          NewItem('Nothing ~H~ere','',0,cmDoNothing,0,
  40.                          NewItem('Just ~D~isabled','',0,cmShowDisabled,0,
  41.                          NewItem('Nothing ~T~here','',0,cmDoNothing,0,
  42.                          nil)))),
  43.                  NewSubMenu('Sub menu ~T~wo',hcNoContext,
  44.                      NewMenu(
  45.                          NewItem('Nothing ~H~ere','',0,cmDoNothing,0,
  46.                          NewItem('Or Here ~E~ither','',0,cmDoNothing,0,
  47.                          nil))),
  48.                  NewItem('This is Disabled','',0,cmShowDisabled,0,
  49.                      nil)))
  50.                 )));
  51.             P^.disableCommands([cmShowDisabled]);
  52.             TestMenu := P;
  53.         end;
  54. {-----------------------------------------}
  55. { Traps our NewWindow and ToggleColor commands }
  56.     procedure TInsApp.HandleEvent(var Event: TEvent);
  57.         var
  58.             R: TRect;
  59.             PW:Pwindow;
  60.         begin
  61.             inherited HandleEvent(Event);
  62.             if Event.What = evCommand then
  63.                 if Event.Command = cmNewWin then
  64.                     begin
  65.                     Inc(WinCount);
  66.                     Desktop^.GetExtent(R);
  67.                     PW := New(PWindow, Init(R, 'Test window', WinCount));
  68.                     PW^.Palette := WinColor;
  69.                     R.assign(1,1,R.B.X-2,2);
  70.                     PW^.insert(TestMenu(R));
  71.                     Desktop^.Insert(PW);
  72.                     end
  73.                 else
  74.                     if Event.Command = cmToggleColor then
  75.                         if     WinColor<2 then inc(WinColor) else WinColor := 0;
  76.         end;
  77. {-----------------------------------------}
  78.     procedure TInsApp.InitMenuBar;
  79.         var
  80.             R: TRect;
  81.         begin
  82.             GetExtent(R);
  83.             R.B.Y := R.A.Y + 1;
  84.             MenuBar := New(PMenuBar, Init(R, NewMenu(
  85.                 NewItem('~A~dd window', 'F3', kbF3, cmNewWin, hcNoContext,
  86.                 NewItem('~T~oggle Color','F2',kbF2,cmToggleColor, hcNoContext,
  87.                 NewItem('E~x~it', 'ALT-X',kbALTX,cmQuit, hcNoContext,
  88.                 nil))))));
  89.         end;
  90. {-----------------------------------------}
  91. { Provides a better Palette for Menus in Windows }
  92.     function TWindowMenuBar.GetPalette:PPalette;
  93.         const     WindowMenuBarPalette:array[0..6] of byte =(6,2,1,3,4,7,4);
  94.         begin
  95.             GetPalette := @WindowMenuBarPalette;
  96.         end;
  97. {-----------------------------------------}
  98. var
  99.     InsApp: TInsApp;
  100. begin
  101.     InsApp.Init;
  102.     InsApp.Run;
  103.     InsApp.Done;
  104. end.
  105.